home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 May / CHIP Mayıs 1997.iso / cont / web / winsock / netxray / data.1 / IMPHOSTS.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-11-26  |  3.1 KB  |  131 lines
  1. ' Note the new keyword "App" that replaces "Lib <libname>" in the Declare
  2. ' statement when the function resides in the App that is calling Enable
  3.  
  4. Declare Sub mcb App (ByVal ctx&, ByVal type%, ByVal errno%, ByVal str$)
  5. Declare Function OpenTextFile App (ByVal filename$) As Integer
  6. Declare Function CloseTextFile App (ByVal fid%) As Integer
  7. Declare Function ReadTextLine App (ByVal fid%, ByVal buf$) As Integer
  8. Declare Function MyGetOpenFilename App (ByVal filename$, ByVal fileExt$, ByVal fileInit$, ByVal filter$) As Integer
  9.  
  10. Dim g_linebuf$ As String * 256
  11. Dim g_buflen% As Integer
  12. Dim g_filename$ As String * 256
  13.  
  14. Sub Main ()
  15.     Dim fid% As Integer
  16.     Dim a_char$ As String
  17.     Dim buf$ As String
  18.     Dim appObj As object
  19.     Dim addrBookObj As object
  20.     Dim FileExt$ As String
  21.     Dim FileInitName$ As String
  22.     Dim FileFilter$ As String
  23.  
  24.     Set appObj = CreateObject("NetXRay.Application.1")
  25.     Set addrBookObj = appObj.GetAddressBookDoc()
  26.  
  27.     FileInitName$ = "hosts"
  28.     FileFilter$ = "All Files(*.*) | *.* ||"
  29.     FileExt$ = " "
  30.  
  31.     bOpen% = MyGetOpenFilename(g_filename$, FileExt$, FileInitName$, FileFilter$)
  32.     If bOpen% = 0 Then
  33.         GoTo CancelOpen
  34.     End If
  35.  
  36.     fid% = OpenTextFile(g_filename$)
  37.     If fid% > 0 Then
  38.         Do
  39. NextLine:
  40.             g_buflen% = ReadTextLine(fid%, g_linebuf$)
  41.             If g_buflen% <= 0 Then        
  42.                 'Exit Do
  43.                 GoTo EndOfFile
  44.             End If
  45.  
  46.             buf$ = StripLeadingSpace(g_linebuf$)
  47.  
  48.             'not enough data
  49.             'g_buflen% = Len(buf$)
  50.             If Len(buf$) < 5 Then        
  51.                 GoTo NextLine
  52.             End If
  53.  
  54.             'skip the comment
  55.             a_char$ = Left$(buf$, 1)
  56.             If a_char$ = "#" Then        
  57.                 GoTo NextLine
  58.             End If
  59.  
  60.             'get the IP token
  61.             ip$ = GetToken(buf$)
  62.  
  63.             bHasName = 0
  64.             buf$ = Right$(buf$, Len(buf$)-Len(ip$))
  65.             buf$ = StripLeadingSpace(buf$)
  66.             If Len(buf$) > 0 Then        
  67.                 'get the 1st Name token
  68.                 name$ = GetToken(buf$)
  69.                 bHasName = 1
  70.             End If
  71.  
  72.             bAddOK = 0
  73.             If bHasName = 1 Then
  74.                 bAddOK = addrBookObj.AddNewAddr(name$, "000000000000", ip$, "", "From hosts file")
  75.             End If
  76.  
  77.         Loop While g_buflen% > 0
  78.  
  79. EndOfFile:
  80.         CloseTextFile(fid%)
  81.     End If
  82.  
  83.     Response = MsgBox("Import file completed!", MB_OK, "NetXRay")
  84.  
  85. CancelOpen:
  86.     i = 0
  87. End Sub
  88.  
  89. 'Get a token
  90. Function GetToken (Buf$ As String) As String
  91.     Dim a_char$, tabCh$, crCh$, lfCh$
  92.     Dim temp$
  93.     tabCh$ = Chr$(9)
  94.     crCh$ = Chr$(13)
  95.     lfCh$ = Chr$(10)
  96.     Pos = 1
  97.     buflen% = Len(Buf$)
  98.     For Pos = 1 To buflen%
  99.         a_char$ = Mid$(Buf$, Pos, 1)
  100.         If a_char$ = " " Or a_char$ = tabCh$ Or a_char$ = crCh$ Or a_char$ = lfCh$ Then
  101.             GetToken = temp$
  102.             Exit Function
  103.         End If
  104.         If Pos = 1 Then
  105.             temp$ = a_char$
  106.         Else
  107.             temp$ = temp$ + a_char$
  108.         End If
  109.     Next Pos
  110.  
  111.     GetToken = temp$
  112. End Function
  113.  
  114. 'remove the leading space and tab chars
  115. Function StripLeadingSpace (Buf As String) As String
  116.     Dim a_char$, tabCh$
  117.     Dim temp$
  118.     temp$ = Buf
  119.     tabCh$ = Chr$(9)
  120.     While (Len(temp$) > 0)
  121.         a_char$ = Left$(temp$, 1)
  122.         If a_char$ <> " " And a_char$ <> tabCh$ Then
  123.             StripLeadingSpace = temp$
  124.             Exit Function
  125.         End If
  126.         temp$ = Right$(temp$, Len(temp$) - 1)
  127.     Wend
  128.  
  129.     StripLeadingSpace = temp$
  130. End Function
  131.